﻿{%MainUnit extFileUtils.pas}
{
 extUtils
 --------
 Additional various routine which not yet available and/or not yet fixed on Lazarus v1.0.x
 
 This Unit is Part of GauExtUtils Package Component for Lazarus.
 Code name Package		: H-Băng
 Branch name Package	: Anh Giờ Đây
  Last Updated 			: 3:53 AM 16/12/2013 (GMT+07)

 Copyright (c) 2012 - 2013, Takeda Matsuki and others
 License : Modified LGPL (follow Lazarus license). 
}

// Real Implementations for functions
  
{-------------------------------------------------------------------------------
function FileAgeUTF8(const FileName: String): Longint;
-------------------------------------------------------------------------------}
{$ifdef Windows}
function extWinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
var
  lft : TFileTime;
begin
  extWinToDosTime:=FileTimeToLocalFileTime(WTime,lft)
    {$ifndef WinCE}
    and FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo)
    {$endif}
    ;
end;
{$endif}

{$ifdef Windows}
Function extDosToWinTime (DosTime:longint;Var Wintime : TFileTime):longbool;
var
 lft : TFileTime;
begin
 extDosToWinTime:=
   {$ifndef wince}
   DosDateTimeToFileTime(longrec(DosTime).hi,longrec(DosTime).lo,@lft) and
   {$endif}
   LocalFileTimeToFileTime(lft,Wintime);                                        ;
end;
{$endif}

{$ifndef WinCE}
function FileAgeAnsi(const FileName: StrCtrl): Longint;
begin
  Result:=SysUtils.FileAge(UTF8ToSys(Filename));
end;
{$endif}

function FileAgeWide(const FileName: StrCtrl): Longint;
var
  Hnd: THandle;
  FindData: TWin32FindDataW;
begin
  Hnd := FindFirstFileW(PWideChar(UTF8ToUTF16(FileName)), FindData);
   if Hnd <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Hnd);
      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
        If extWinToDosTime(FindData.ftLastWriteTime,Result) then
          exit;
    end;
   Result := -1;
end;

{-------------------------------------------------------------------------------
FileSetDateUTF8
-------------------------------------------------------------------------------}
{$ifndef WinCE}
function FileSetDateAnsi(const FileName: StrCtrl; Age: Longint): Longint;
begin
 Result:=SysUtils.FileSetDate(UTF8ToSys(Filename),Age);
end;
{$endif}

function FileSetDateWide(const FileName: StrCtrl; Age: Longint): Longint;
var
 FT:TFileTime;
 fh: HANDLE;
begin
   try
     fh := CreateFileW(PWideChar(UTF8ToUTF16(FileName)),
                       FILE_WRITE_ATTRIBUTES,
                       0, nil, OPEN_EXISTING,
                       FILE_ATTRIBUTE_NORMAL, 0);
     if (fh <> feInvalidHandle) and (extDosToWinTime(Age,FT) and SetFileTime(fh, nil, nil, @FT)) then
       Result := 0
     else
       Result := GetLastError;
   finally
     if (fh <> feInvalidHandle) then FileClose(fh);
   end;
end;

function IsValidPeWide(const FileName :StrCtrl) :Boolean;
var
  hFile       :DWORD;
  DosHeader   :TImageDosHeader;
  NtHeaders   :TImageNtHeaders;
  dwRead      :DWORD;
begin
  Result := True;

  hFile := CreateFileW(PWideChar(UTF8ToUTF16(FileName)),
           GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); // Unicode Ready !
  try
    try
      SetFilePointer(hFile, 0, nil, FILE_BEGIN);
      ReadFile(hFile, DosHeader, SizeOf(DosHeader), dwRead, nil);

      if DosHeader.e_magic <> IMAGE_DOS_SIGNATURE then // Check PE Signature (MZ)
        Result := False
      else
      begin
        SetFilePointer(hFile, DosHeader._lfanew, nil, FILE_BEGIN);
        ReadFile(hFile, NtHeaders, SizeOf(NtHeaders), dwRead, nil);

        if NtHeaders.Signature <> IMAGE_NT_SIGNATURE then
          Result := False;
      end;
    except
      On Exception do
        Result := False;
    end;
  finally
    CloseHandle(hFile);
  end;
end;

function PeFileTypeWide(const FileName :StrCtrl):StrCtrl;
var
  hFile       :DWORD;
  DosHeader   :TImageDosHeader;
  NtHeaders   :TImageNtHeaders;
  dwRead      :DWORD;
begin
  Result := 'UnKnown file type or this file is not valid PE';

  if not IsValidPe(FileName) then
    Exit;

  hFile := CreateFileW(PWideChar(UTF8ToUTF16(FileName)),
           GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); //Unicode Ready !
  try
    ReadFile(hFile, DosHeader, SizeOf(DosHeader), dwRead, nil);

    SetFilePointer(hFile, DosHeader._lfanew, nil, FILE_BEGIN);

    ReadFile(hFile, NtHeaders, SizeOf(NtHeaders), dwRead, nil);

    if NtHeaders.OptionalHeader.Magic = $10B then // 0x10B PE32
      Result := '32bit';
    if NtHeaders.OptionalHeader.Magic = $20B then // 0x20B PE32+
      Result := '64bit';
  finally
    CloseHandle(hFile);
  end
end;

function IsValidPeAnsi(const FileName :StrCtrl) :Boolean;
var
  hFile       :DWORD;
  DosHeader   :TImageDosHeader;
  NtHeaders   :TImageNtHeaders;
  dwRead      :DWORD;
begin
  Result := True;

  hFile := CreateFile(PChar(FileName), 
           GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); // Ansi Version !
  try
    try
      SetFilePointer(hFile, 0, nil, FILE_BEGIN);
      ReadFile(hFile, DosHeader, SizeOf(DosHeader), dwRead, nil);

      if DosHeader.e_magic <> IMAGE_DOS_SIGNATURE then // Check PE Signature (MZ)
        Result := False
      else
      begin
        SetFilePointer(hFile, DosHeader._lfanew, nil, FILE_BEGIN);
        ReadFile(hFile, NtHeaders, SizeOf(NtHeaders), dwRead, nil);

        if NtHeaders.Signature <> IMAGE_NT_SIGNATURE then
          Result := False;
      end;
    except
      On Exception do
        Result := False;
    end;
  finally
    CloseHandle(hFile);
  end;
end;

function PeFileTypeAnsi(const FileName :StrCtrl):StrCtrl;
var
  hFile       :DWORD;
  DosHeader   :TImageDosHeader;
  NtHeaders   :TImageNtHeaders;
  dwRead      :DWORD;
begin
  Result := 'UnKnown file type or this file is not valid PE';

  if not IsValidPe(FileName) then
    Exit;

  hFile := CreateFile(PChar(FileName), 
           GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); //Ansi version !
  try
    ReadFile(hFile, DosHeader, SizeOf(DosHeader), dwRead, nil);

    SetFilePointer(hFile, DosHeader._lfanew, nil, FILE_BEGIN);

    ReadFile(hFile, NtHeaders, SizeOf(NtHeaders), dwRead, nil);

    if NtHeaders.OptionalHeader.Magic = $10B then // 0x10B PE32
      Result := '32bit';
    if NtHeaders.OptionalHeader.Magic = $20B then // 0x20B PE32+
      Result := '64bit';
  finally
    CloseHandle(hFile);
  end
end; 

function FileExistsAnsi (Const FileName : StrCtrl) : Boolean; 	 
var 	 
 Attr:Dword; 	 
begin 	 
 Attr:=GetFileAttributesA(PChar(FileName)); 	 
 if Attr <> $ffffffff then 	 
	Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0 	 
 else 	 
	Result:=False; 	 
end;

function FileExistsWide (Const FileName : StrCtrl) : Boolean;
var
 Attr:Dword;
begin
 Attr:=GetFileAttributesW(PWideChar(UTF8ToUTF16(FileName)));
 if Attr <> $ffffffff then
  Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
 else
  Result:=False;
end;

function DirectoryExistsAnsi (Const Directory : StrCtrl) : Boolean; 	 
var 	 
 Attr:Dword; 	 
begin 	 
 Attr:=GetFileAttributesA(PChar(Directory)); 	 
 if Attr <> $ffffffff then 	 
	Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0 	 
 else 	 
	Result:=False; 	 
end;

function DirectoryExistsWide (Const Directory : StrCtrl) : Boolean;
var
 Attr:Dword;
begin
 Attr:=GetFileAttributesW(PWideChar(UTF8ToUTF16(Directory)));
 if Attr <> $ffffffff then
  Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
 else
  Result:=False;
end;

function iGetCurDirAnsi : StrCtrl;
var
  ABuffer:AnsiString;
  ALength:Integer;
begin
{$ifndef WinCE}
  ALength:=GetCurrentDirectory(0, nil);
  SetLength(ABuffer, ALength);
  ALength:=Windows.GetCurrentDirectory(ALength, @ABuffer[1]);
  SetLength(ABuffer, ALength);

  // Use LazUTF8.UTF16ToUTF8 instead UTF8Encode from FPC RTL
  // Now, it would working with Unicode
  Result:=ABuffer;
{$else}
 Result := '???';
{$endif}
end;   

function iGetCurDirWide : StrCtrl;
var
  ABuffer:WideString;
  ALength:Integer;
begin
{$ifdef WinCE}
  Result := '\';
{$else}
  ALength:=GetCurrentDirectoryW(0, nil);
  SetLength(ABuffer, ALength);
  ALength:=Windows.GetCurrentDirectoryW(ALength, @ABuffer[1]);
  SetLength(ABuffer, ALength);

  // Use LazUTF8.UTF16ToUTF8 instead UTF8Encode from FPC RTL
  // Now, it would working with Unicode
  Result:=UTF16ToUTF8(ABuffer);
{$endif}
end;           

{---------------------------------------------------------------------------------------------------}
var
  FileAge_         : function (const Filename : StrCtrl):Longint = @FileAgeWide;
  FileSetDate_     : function (const FileName : StrCtrl; Age: Longint): Longint = @FileSetDateWide;
  IsValidPe_	   : function (const FileName : StrCtrl) :Boolean = @IsValidPeWide;
  PEFileType_	   : function (const FileName : StrCtrl):StrCtrl = @PeFileTypeWide;
  FileExists_	   : function (const FileName : StrCtrl) : Boolean = @FileExistsWide;
  DirectoryExists_ : function (const Directory : StrCtrl) : Boolean = @DirectoryExistsWide;
  GetCurDir_ 	   : function : StrCtrl = @iGetCurDirWide;
{---------------------------------------------------------------------------------------------------}



// Contains functions name

function extFileAgeUTF8(const FileName: StrCtrl): Longint;
begin
  Result:=FileAge_(FileName);
end;

function extFileSetDateUTF8(const FileName: StrCtrl; Age: Longint): Longint;
begin
  Result:=FileSetDate_(FileName, Age);
end;

function IsValidPe(const FileName :StrCtrl) :Boolean;
begin
 Result:=IsValidPe_(FileName); 
end;

function PeFileType(const FileName :StrCtrl):StrCtrl;
begin
 Result:=PeFileType_(FileName);
end;

function extIsFileExists (Const FileName : StrCtrl) : Boolean;
begin
 Result:=FileExists_(FileName);
end;

function extIsDirectoryExists (const Directory : StrCtrl) : Boolean;
begin
 Result:=DirectoryExists_(Directory);
end;

function extGetCurDirUTF8 : StrCtrl;
begin
 Result:=GetCurDir_();
end;

{---------------------------------------------------------------------------------------------------}

procedure InitUtils;
begin
  {$ifndef WinCE}
  if Win32MajorVersion <= 4 then
  begin
    FileAge_:=@FileAgeAnsi;
    FileSetDate_:=@FileSetDateAnsi;
	IsValidPe_:=@IsValidPeAnsi;
	PEFileType_:=@PeFileTypeAnsi;
	FileExists_:=@FileExistsAnsi;
	DirectoryExists_:=@DirectoryExistsAnsi;
	GetCurDir_:=@iGetCurDirAnsi;
  end;
  {$endif}
end;  
